home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / think-c / tc-menu.el < prev    next >
Encoding:
Text File  |  1994-05-04  |  4.5 KB  |  140 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; Code to install a menu to send events to Think C
  3. ;;;
  4.  
  5. (defun tc:do-compile (menu item)
  6.   (let ((err (tc:compile-file (buffer-name))))
  7.     (report-error-in-message-line err)))
  8.  
  9. (defun tc:do-disassemble (menu item)
  10.   (let ((err (tc:disassemble (buffer-name))))
  11.     (report-error-in-message-line err)))
  12.  
  13. (defun tc:do-make (menu item)
  14.   (save-some-buffers)
  15.   (let ((err (tc:make)))
  16.     (report-error-in-message-line err)))
  17.  
  18. (defun tc:do-open-project (menu item)
  19.   (let* ((file (call-interactively (function (lambda (x)
  20.                                                (interactive "fProject to open: ")
  21.                                                x))))
  22.          (err (tc:open-project (expand-file-name file))))
  23.     (report-error-in-message-line err)))
  24.  
  25. (defun tc:do-close-project (menu item)
  26.   (tc:close-project))
  27.  
  28. (defun tc:do-build-application (menu item)
  29.   (save-some-buffers)
  30.   (let* ((file (call-interactively (function (lambda (x)
  31.                                                (interactive "FSave application as: ")
  32.                                                x))))
  33.          (err (tc:build-application (expand-file-name file))))
  34.     (report-error-in-message-line err)))
  35.  
  36. (defun tc:do-run (menu item)
  37.   (save-some-buffers)
  38.   (let ((err (tc:run)))
  39.     (report-error-in-message-line err)))
  40.  
  41. (defun tc:do-use-debugger (menu item)
  42.   (setq tc:use-debugger (not tc:use-debugger))
  43.   (CheckItem tc:compile-menu 10 (if tc:use-debugger 1 0)))
  44.  
  45. (defun tc:do-preprocess (menu item)
  46.   (let ((err (tc:preprocess (buffer-name))))
  47.     (report-error-in-message-line err)))
  48.  
  49. (defun tc:do-check-syntax (menu item)
  50.   (let ((err (tc:check-syntax (buffer-name))))
  51.     (report-error-in-message-line err)))
  52.  
  53. (defun find-closing-paren-internal ()
  54.   (let ((out 1)
  55.     (result t))
  56.     (while (not (zerop out))
  57.       (let ((next-find (re-search-forward "[][(){}]" nil t)))
  58.     (if next-find
  59.         (setq out (+ out
  60.              (if (string-match (regexp-quote (char-to-string (preceding-char))) "({[")
  61.                  1 -1)))
  62.       (setq out 0)
  63.       (setq result nil))))
  64.     result))
  65.  
  66. (defvar latest-find)
  67.  
  68. (defun find-closing-paren ()
  69.   (let ((start (point))
  70.     (closing-paren (find-closing-paren-internal)))
  71.     (if closing-paren
  72.     (progn
  73.       (setq latest-find (point))
  74.       (blink-matching-open)
  75.       (if (not (= (point) latest-find))
  76.           (goto-char latest-find)))
  77.       (message "Nothing more to balance")
  78.       (goto-char start))))
  79.  
  80. (defun tc:do-balance (menu item)
  81.   (find-closing-paren))
  82.  
  83. (defun tc:do-remove-objects (menu item)
  84.   (tc:remove-objects))
  85.  
  86. (defun tc:do-launch-tpm (menu item)
  87.   (tc:launch-tpm))
  88.  
  89. (defun tc:do-finf (menu item)
  90.   (tc:send-finf))
  91.  
  92. (defun tc:do-nmat (menu item)
  93.   (tc:send-nmat))
  94.  
  95. (defun tc:do-pmat (menu item)
  96.   (tc:send-pmat))
  97.  
  98. (defun tc:need-tpm-alias-message ()
  99.   (message "Put an alias to the Think Project Manager named “TPM” in the etc folder of Emacs."))
  100.  
  101. (defun tc:launch-tpm ()
  102.   "Launch Think Project Manager.  There should be an alias to the Think Project Manager called TPM in ~/etc."
  103.   (let ((err (launch-application "TPM")))
  104.     (if (= err fnfErr)
  105.         (tc:need-tpm-alias-message)
  106.       (report-error-in-message-line err))))
  107.  
  108. (defvar tc:have-menus nil)
  109.  
  110. (if (not tc:have-menus)
  111.     (progn
  112.       (setq tc:edit-menu (NewMenu (get-unique-menu-ID) "Project"))
  113.       (AppendMenu tc:edit-menu "Launch Think Project Manager/0" 'tc:do-launch-tpm)
  114.       (AppendMenu tc:edit-menu "Open Project..." 'tc:do-open-project)
  115.       (AppendMenu tc:edit-menu "Close Project" 'tc:do-close-project)
  116.       (AppendMenu tc:edit-menu "(-" nil)
  117.       (AppendMenu tc:edit-menu "Balance/B" 'tc:do-balance)
  118.       (AppendMenu tc:edit-menu "Find In Next File/T" 'tc:do-finf)
  119.       (AppendMenu tc:edit-menu "(-" nil)
  120.       (AppendMenu tc:edit-menu "Go To Next Error/'" 'tc:do-nmat)
  121.       (AppendMenu tc:edit-menu "Go To Previous Error/`" 'tc:do-pmat)
  122.       (InsertMenu tc:edit-menu 0)
  123.  
  124.       (setq tc:compile-menu (NewMenu (get-unique-menu-ID) "Compile"))
  125.       (AppendMenu tc:compile-menu "Preprocess" 'tc:do-preprocess)
  126.       (AppendMenu tc:compile-menu "Check Syntax/Y" 'tc:do-check-syntax)
  127.       (AppendMenu tc:compile-menu "Disassemble" 'tc:do-disassemble)
  128.       (AppendMenu tc:compile-menu "Compile/K" 'tc:do-compile)
  129.       (AppendMenu tc:compile-menu "(-" nil)
  130.       (AppendMenu tc:compile-menu "Remove Objects" 'tc:do-remove-objects)
  131.       (AppendMenu tc:compile-menu "Make and Use Disk/\\" 'tc:do-make)
  132.       (AppendMenu tc:compile-menu "Build Application..." 'tc:do-build-application)
  133.       (AppendMenu tc:compile-menu "(-" nil)
  134.       (AppendMenu tc:compile-menu "Use Debugger" 'tc:do-use-debugger)
  135.       (AppendMenu tc:compile-menu "Run/R" 'tc:do-run)
  136.       (InsertMenu tc:compile-menu 0)
  137.       (DrawMenuBar)
  138.  
  139.       (setq tc:have-menus t)))
  140.